home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s2.arc / KADJUSTF.MOD next >
Text File  |  1987-07-17  |  5KB  |  118 lines
  1. (*----------------------------------------------------------------------*)
  2. (*    Kermit_Adjust_File_Name --- Adjust file name of incoming file     *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION Kermit_Adjust_File_Name(     Old_Name : AnyStr;
  6.                                   VAR New_Name : AnyStr  ) : BOOLEAN;
  7.  
  8. (*----------------------------------------------------------------------*)
  9. (*                                                                      *)
  10. (*     Function:   Kermit_Adjust_File_Name                              *)
  11. (*                                                                      *)
  12. (*     Purpose:    Adjust file name of incoming file for Kermit         *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*        OK := Kermit_Adjust_File_Name(     Old_Name : AnyStr;         *)
  17. (*                                       VAR New_Name : AnyStr )        *)
  18. (*                                       : BOOLEAN;                     *)
  19. (*                                                                      *)
  20. (*           Old_Name --- old file name                                 *)
  21. (*           New_Name --- new file name                                 *)
  22. (*           OK       --- TRUE if new file name could be found          *)
  23. (*                                                                      *)
  24. (*     Calls:                                                           *)
  25. (*                                                                      *)
  26. (*        Split_File_Name                                               *)
  27. (*        Check_If_File_Exists                                          *)
  28. (*                                                                      *)
  29. (*     Remarks:                                                         *)
  30. (*                                                                      *)
  31. (*        This routine prevents an existing file from being overwritten *)
  32. (*        by changing the file name.                                    *)
  33. (*                                                                      *)
  34. (*----------------------------------------------------------------------*)
  35.  
  36. VAR
  37.    Temp_Fn : AnyStr;
  38.    Drive   : CHAR;
  39.    Path    : AnyStr;
  40.    FileName: AnyStr;
  41.    FileType: AnyStr;
  42.    Bad_Name: BOOLEAN;
  43.    IPos    : INTEGER;
  44.    OK      : BOOLEAN;
  45.  
  46. BEGIN (* Kermit_Adjust_File_Name *)
  47.  
  48.                                    (* Convert file name to upper case *)
  49.  
  50.    Temp_Fn := UpperCase( Old_Name );
  51.  
  52.                                    (* Extract file name parts         *)
  53.  
  54.    Split_File_Name( Temp_Fn, Drive, Path, FileName, FileType, Bad_Name );
  55.  
  56.                                    (* Fix up path            *)
  57.    IF ( Path = '' ) THEN
  58.       IF  ( Drive = ' ' ) THEN
  59.          Path := Download_Dir_Path
  60.       ELSE
  61.          Path := Drive + ':'
  62.    ELSE
  63.       IF ( Drive <> ' ') THEN
  64.          Path := Drive + ':' + Path;
  65.  
  66.                                    (* If file name bad, quit *)
  67.    IF ( NOT Bad_Name ) THEN
  68.       BEGIN                        (* Legitimate file name, proceed *)
  69.  
  70.          Temp_Fn  := FileName + DUPL(' ' , 8 - LENGTH( FileName ) ) + '.' +
  71.                      FileType + DUPL(' ' , 3 - LENGTH( FileType ) );
  72.          OK       := FALSE;
  73.  
  74.          REPEAT                    (* First try adding in &s to replace *)
  75.                                    (* blanks in file name               *)
  76.  
  77.             New_Name := Temp_Fn;
  78.             IPos     := POS( ' ', New_Name );
  79.  
  80.             IF ( IPos <> 0 ) THEN
  81.                BEGIN
  82.                   DELETE( New_Name, IPos, 1 );
  83.                   INSERT( '&',     New_Name,   IPos);
  84.                   Temp_Fn := New_Name;
  85.                   WHILE ( POS(' ' , New_Name ) <> 0 ) DO
  86.                      DELETE( New_Name, POS(' ',New_Name), 1 );
  87.                   OK := ( NOT Check_If_File_Exists( New_Name , Path ) );
  88.                END;
  89.  
  90.          UNTIL ( OK OR ( IPos = 0 ) );
  91.  
  92.                                    (* If that didn't work, try replacing     *)
  93.                                    (* file name characters with &s, starting *)
  94.                                    (* at end of file name.                   *)
  95.  
  96.          IF ( NOT OK ) THEN
  97.             BEGIN
  98.                IPos := LENGTH( New_Name );
  99.                REPEAT
  100.                   IF ( ( New_Name[IPos] <> '&' ) AND
  101.                        ( New_Name[IPos] <> '.' ) ) THEN
  102.                      BEGIN
  103.                         New_Name[IPos] := '&';
  104.                         OK := ( NOT Check_If_File_Exists( New_Name , Path ) );
  105.                      END
  106.                   ELSE
  107.                      IPos := IPos - 1;
  108.                UNTIL ( IPos <= 0 ) OR OK;
  109.             END;
  110.  
  111.       END (* Legitimate file name *)
  112.    ELSE
  113.       OK := FALSE;
  114.  
  115.    Kermit_Adjust_File_Name := OK;
  116.  
  117. END    (* Kermit_Adjust_File_Name *);
  118.